home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu453.dms / pu453.adf / extras / basic_sources / wdb_GrabMe!.bas < prev    next >
BASIC Source File  |  1992-11-08  |  1KB  |  66 lines
  1. SCREEN 1,960,768,3,4
  2. WINDOW 1,"WorldDataBank",(0,1)-(930,740),0,1
  3. PALETTE 0,0,0,0   : PALETTE 1,0,.7,0
  4. PALETTE 2,1,0,0   : PALETTE 3,1,1,1
  5. PALETTE 4,.7,.7,0  : PALETTE 5,0,1,0
  6. PALETTE 6,.2,.7,.5 : PALETTE 7,0,0,1
  7.  
  8. xs% = 0   : ys% = 0 
  9. xe% = 930 : ye% = 740
  10. xw% = 930 : yw% = 740
  11.  
  12. REM $option K700
  13.  
  14. OPEN "I",#1,"dh2:worlddatabank/wdb.2.all"
  15.     l = LOF(1)
  16.     big$ = INPUT$(l,#1)
  17.     mloc& = SADD(big$)
  18. CLOSE #1
  19.  
  20. nrec = (l/6)-1
  21.  
  22. n& = -1
  23. mag% = 4
  24. xoff = 0.4
  25. yoff = 0.54
  26.  
  27. xw% = xw% * mag%
  28. yw% = yw% * mag%
  29. xd& = INT(10800 - (xoff*21600))
  30. yd& = INT(5400  - (yoff*10800))
  31. xm  = xw%/21600
  32. ym  = yw%/10800
  33.  
  34. WHILE INKEY$ = "" AND n& < nrec
  35.     INCR n&
  36.  
  37.     x1& = (n&*6)+mloc&
  38.     t% = PEEKW(x1&)
  39.     y% = PEEKW(x1&+2)
  40.     x% = PEEKW(x1&+4)
  41.     
  42.     x% = x% + xd&
  43.     y% = y% + yd&
  44.     x% = INT(x% * xm)
  45.     y% = INT(y% * ym)
  46.     x% = x% + xs%
  47.     y% = y% + ys%
  48.     y% = ye% - y%
  49.     
  50.     IF t% > 10 THEN
  51.         COLOR INT(t%/1000)
  52.         IF x% < xe% AND x% > xs% AND y% < ye% AND y% > ys%
  53.             PSET(x%,y%)
  54.         END IF
  55.         ox% = x% : oy% = y%
  56.     ELSE    
  57.         IF x% < xe% AND x% > xs% AND y% < ye% AND y% > ys%
  58.             IF ABS(x%-ox%) < 300 THEN
  59.                 LINE (ox%,oy%)-(x%,y%)
  60.             END IF 
  61.         END IF
  62.         ox% = x% : oy% = y%
  63.     END IF
  64. WEND
  65.  
  66.